1 Wstęp

Zbiory danych zawierały bardzo dużo atrybutów dotyczących krajów, gospodarek, walut i cen. Zebrane zostały na przestrzeni wielu lat i przestawiały interesujące dane. Dzięki analizie udało ustalić, że wiele atrybutów znacząco koreluje z cenami złota jak i cenami bitcoina. Na ich podstawie można stworzyć model regresji, który z dużą skutecznością jest w stanie przewidzieć ceny złota.

Ostatecznie regresor został wytrenowany na podstawie poniższych danych:
S&P:
- Divident
- Earnings
- CPI
- Real.Divident
Światowy wskaźnik rozwoju:
-GDP (current US dollar)

Wytrenowany model dla zbioru testowego przyjął następujące wartości miar:
- RMSE = 26.35187
- MAE = 13.19214

Najważniejszymi atrybutami dla trenowanego modelu okazało się: CPI - model RandomForest
GDP - model RandomForest z dobranymi parametrami

2 Biblioteki

Wykorzystane biblioteki:

library(readxl)
library(corrplot)
library(caret)
library(dplyr)
library(tidyr)
library(plotly)
library(ggplot2)
library(tidyverse)
library(ggpubr)
library(patchwork)
library(hrbrthemes)
library(DT)
library(gganimate)
library(gifski)
library(randomForest)
library(Metrics)

3 Zapewnienie powtarzalności

Zapewnienie powtarzalności wyników w projekcie uzyskano dzięki ustawieniu ziarna generatora liczb losowych.

set.seed(42)

4 Wczytywanie danych

W przypadku bitcoina wykorzystany zostanie zbiór danych zawierających jego cenę w danym dniu wyrażoną w dolarach.

INDI  <- read_xlsx("Data pack/World_Development_Indicators.xlsx", na = '..')
RATES <- read.csv("Data pack/CurrencyExchangeRates.csv")
GOLD <- read.csv("Data pack/Gold prices.csv")
COMP <- read.csv("Data Pack/S&P Composite.csv")
MKPRU <- read.csv("Data pack/Bitcoin/BCHAIN-MKPRU.csv")

5 Podsumowanie danych

5.1 Światowy wskaźnik rozwoju - INDI

Spośród wielu krajów wybrać można kraje posiadające największe PKB kolejno: Stany Zjednoczone, Chiny, Japonia, Niemcy oraz Wielka Brytania czy kraje posiadających najwięcej rezerw złota w tonach: Stany zjednoczone, Niemcy Włochy, Francja oraz Rosja. Kraje te powinny wywierać największy wpływ na ceny surowców dostępnych na całym świecie. Ostatecznie wybrane zostały statystyki dla całego świata, dzięki czemu naraz ujęte w analizie zostaną zarówno największe mocarstwa, jak i te drobniejsze kraje.

INDI <- INDI %>% 
  filter(`Country Name` %in% c("World"))

Można zauważyć, że zebrane dane w wielu latach posiadają dużą ilość brakujących wartości. Uzupełnianie brakujących wartości nie byłoby proste i mogłoby spowodować zakłamanie wyników, dlatego po przekształceniu zbioru zostały usunięte rekordy w których występowały wartości puste.

INDI <- INDI %>% 
  select(-c("Country Name","Country Code")) %>%
  gather("Year", "Value", -c("Series Name", "Series Code")) %>%
  mutate(Year = substr(Year, 1, 4), `Series Name` = gsub("\\$", " dollar", `Series Name`)) 

Zbiór danych dodatkowo został przekształcony, aby ułatwić pracę nad nim i uzyskać przejrzystość danych.

INDI <- INDI %>%
  drop_na()
summary(INDI)
##  Series Name        Series Code            Year               Value           
##  Length:5738        Length:5738        Length:5738        Min.   :-1.686e+11  
##  Class :character   Class :character   Class :character   1st Qu.: 1.300e+01  
##  Mode  :character   Mode  :character   Mode  :character   Median : 4.100e+01  
##                                                           Mean   : 1.294e+12  
##                                                           3rd Qu.: 4.935e+06  
##                                                           Max.   : 1.012e+14

5.2 Kursy walut - RATES

W przypadku kursów wymiany walut dane zbierane były od 1995 do 2018 roku. Można zauważyć, że prawie wszystkie z podanych walut mają wartości puste a wiele z nich nawet powyżej 4000 pustych pomiarów. Może to wynikać z dynamiki geopolitycznej krajów. Na świecie na przestrzeni lat wiele walut było wprowadzonych do obiegu, jak i z niego wyprowadzanych. Możliwe też, że po prostu zbiór danych nie jest pełny. Ze względu na dużą ilość wartości pustych uzupełnianie ich o wartości bazujące na poprzedzających/następujących wartościach mogłoby spowodować zakłamanie badanych wartości. Natomiast usunięcie wartości pustych powoduje, że zostają tylko lata 2010 do 2018 i to niepełne. Dlatego ten zbiór danych nie będzie wykorzystany w późniejszych badaniach.

RATES$Date <- as.Date(RATES$Date)
summary(RATES)
##       Date            Algerian.Dinar   Australian.Dollar Bahrain.Dinar  
##  Min.   :1995-01-02   Min.   : 71.29   Min.   :0.4833    Min.   :0.376  
##  1st Qu.:2000-10-05   1st Qu.: 77.50   1st Qu.:0.6654    1st Qu.:0.376  
##  Median :2006-07-06   Median : 81.28   Median :0.7595    Median :0.376  
##  Mean   :2006-07-27   Mean   : 90.59   Mean   :0.7683    Mean   :0.376  
##  3rd Qu.:2012-05-07   3rd Qu.:108.88   3rd Qu.:0.8689    3rd Qu.:0.376  
##  Max.   :2018-05-02   Max.   :115.58   Max.   :1.1055    Max.   :0.376  
##                       NA's   :4112     NA's   :263       NA's   :69     
##  Bolivar.Fuerte     Botswana.Pula    Brazilian.Real  Brunei.Dollar  
##  Min.   :    2.14   Min.   :0.0855   Min.   :0.832   Min.   :1.000  
##  1st Qu.:    2.59   1st Qu.:0.1197   1st Qu.:1.709   1st Qu.:1.348  
##  Median :    6.28   Median :0.1528   Median :2.048   Median :1.468  
##  Mean   :  835.09   Mean   :0.1965   Mean   :2.161   Mean   :1.508  
##  3rd Qu.:    6.28   3rd Qu.:0.1844   3rd Qu.:2.794   3rd Qu.:1.698  
##  Max.   :68827.50   Max.   :4.8414   Max.   :4.195   Max.   :1.851  
##  NA's   :3664       NA's   :1275     NA's   :539     NA's   :1246   
##  Canadian.Dollar  Chilean.Peso    Chinese.Yuan   Colombian.Peso  
##  Min.   :0.917   Min.   :377.5   Min.   :6.093   Min.   : 833.2  
##  1st Qu.:1.086   1st Qu.:503.5   1st Qu.:6.495   1st Qu.:1786.0  
##  Median :1.297   Median :538.6   Median :6.989   Median :2017.6  
##  Mean   :1.268   Mean   :561.8   Mean   :7.316   Mean   :2073.1  
##  3rd Qu.:1.409   3rd Qu.:619.8   3rd Qu.:8.277   3rd Qu.:2482.9  
##  Max.   :1.613   Max.   :758.2   Max.   :8.746   Max.   :3434.9  
##  NA's   :356     NA's   :1220    NA's   :1316    NA's   :582     
##   Czech.Koruna    Danish.Krone        Euro        Hungarian.Forint
##  Min.   :14.45   Min.   :4.665   Min.   :0.8252   Min.   :144.1   
##  1st Qu.:19.35   1st Qu.:5.612   1st Qu.:1.0889   1st Qu.:202.7   
##  Median :21.88   Median :6.051   Median :1.2295   Median :224.3   
##  Mean   :22.95   Mean   :6.281   Mean   :1.2076   Mean   :231.1   
##  3rd Qu.:24.94   3rd Qu.:6.805   3rd Qu.:1.3338   3rd Qu.:267.6   
##  Max.   :40.29   Max.   :9.006   Max.   :1.5990   Max.   :318.7   
##  NA's   :1850    NA's   :251     NA's   :1070     NA's   :1415    
##  Icelandic.Krona   Indian.Rupee   Indonesian.Rupiah  Iranian.Rial  
##  Min.   : 54.72   Min.   :31.37   Min.   : 2201     Min.   : 1699  
##  1st Qu.: 70.28   1st Qu.:42.82   1st Qu.: 8855     1st Qu.: 1755  
##  Median : 83.48   Median :45.92   Median : 9260     Median : 8992  
##  Mean   : 92.46   Mean   :48.02   Mean   : 9144     Mean   :10718  
##  3rd Qu.:117.15   3rd Qu.:52.33   3rd Qu.:11380     3rd Qu.:11180  
##  Max.   :147.98   Max.   :68.78   Max.   :14850     Max.   :42000  
##  NA's   :354      NA's   :429     NA's   :1492      NA's   :1312   
##  Israeli.New.Sheqel  Japanese.Yen    Kazakhstani.Tenge   Korean.Won  
##  Min.   :3.230      Min.   : 75.86   Min.   :117.2     Min.   : 756  
##  1st Qu.:3.676      1st Qu.:100.70   1st Qu.:145.4     1st Qu.:1013  
##  Median :3.882      Median :109.39   Median :150.3     Median :1122  
##  Mean   :4.003      Mean   :107.97   Mean   :185.6     Mean   :1100  
##  3rd Qu.:4.370      3rd Qu.:118.38   3rd Qu.:185.7     3rd Qu.:1186  
##  Max.   :4.994      Max.   :147.00   Max.   :383.9     Max.   :1965  
##  NA's   :1939       NA's   :316      NA's   :3051      NA's   :601   
##  Kuwaiti.Dinar     Libyan.Dinar   Malaysian.Ringgit Mauritian.Rupee
##  Min.   :0.2646   Min.   :0.525   Min.   :2.436     Min.   :25.15  
##  1st Qu.:0.2854   1st Qu.:0.662   1st Qu.:3.188     1st Qu.:29.12  
##  Median :0.2947   Median :1.932   Median :3.676     Median :30.67  
##  Mean   :0.2936   Mean   :1.510   Mean   :3.508     Mean   :31.03  
##  3rd Qu.:0.3027   3rd Qu.:1.932   3rd Qu.:3.800     3rd Qu.:32.89  
##  Max.   :0.3089   Max.   :1.932   Max.   :4.725     Max.   :36.50  
##  NA's   :1054     NA's   :123     NA's   :301       NA's   :2460   
##   Mexican.Peso    Nepalese.Rupee   New.Zealand.Dollar Norwegian.Krone
##  Min.   : 5.915   Min.   : 49.88   Min.   :0.3927     Min.   :4.959  
##  1st Qu.:10.953   1st Qu.: 68.33   1st Qu.:0.5813     1st Qu.:6.104  
##  Median :12.680   Median : 74.04   Median :0.6844     Median :6.709  
##  Mean   :13.116   Mean   : 77.37   Mean   :0.6606     Mean   :6.965  
##  3rd Qu.:13.668   3rd Qu.: 86.80   3rd Qu.:0.7364     3rd Qu.:7.806  
##  Max.   :21.908   Max.   :109.98   Max.   :0.8822     Max.   :9.606  
##  NA's   :2266     NA's   :479      NA's   :310        NA's   :291    
##    Nuevo.Sol     Pakistani.Rupee  Peso.Uruguayo   Philippine.Peso
##  Min.   :2.539   Min.   : 30.88   Min.   : 9.32   Min.   :24.55  
##  1st Qu.:2.755   1st Qu.: 51.79   1st Qu.:20.07   1st Qu.:43.18  
##  Median :2.819   Median : 60.75   Median :22.94   Median :44.40  
##  Mean   :2.960   Mean   : 70.24   Mean   :24.11   Mean   :45.01  
##  3rd Qu.:3.243   3rd Qu.: 94.29   3rd Qu.:28.44   3rd Qu.:47.10  
##  Max.   :3.522   Max.   :115.70   Max.   :32.53   Max.   :52.35  
##  NA's   :4297    NA's   :488      NA's   :4287    NA's   :4198   
##   Polish.Zloty    Qatar.Riyal     Rial.Omani     Russian.Ruble  
##  Min.   :2.022   Min.   :3.64   Min.   :0.3845   Min.   :23.13  
##  1st Qu.:3.033   1st Qu.:3.64   1st Qu.:0.3845   1st Qu.:28.27  
##  Median :3.290   Median :3.64   Median :0.3845   Median :30.54  
##  Mean   :3.365   Mean   :3.64   Mean   :0.3845   Mean   :36.91  
##  3rd Qu.:3.822   3rd Qu.:3.64   3rd Qu.:0.3845   3rd Qu.:36.20  
##  Max.   :4.500   Max.   :3.64   Max.   :0.3845   Max.   :83.59  
##  NA's   :1765    NA's   :47     NA's   :56       NA's   :2435   
##  Saudi.Arabian.Riyal Singapore.Dollar South.African.Rand Sri.Lanka.Rupee 
##  Min.   :3.745       Min.   :1.201    Min.   : 3.530     Min.   : 49.57  
##  1st Qu.:3.745       1st Qu.:1.361    1st Qu.: 6.213     1st Qu.: 77.54  
##  Median :3.750       Median :1.444    Median : 7.480     Median :103.99  
##  Mean   :3.749       Mean   :1.503    Mean   : 8.113     Mean   :102.19  
##  3rd Qu.:3.750       3rd Qu.:1.687    3rd Qu.: 9.995     3rd Qu.:126.29  
##  Max.   :3.750       Max.   :1.851    Max.   :16.771     Max.   :157.65  
##  NA's   :46          NA's   :259      NA's   :535        NA's   :509     
##  Swedish.Krona     Swiss.Franc       Thai.Baht     Trinidad.And.Tobago.Dollar
##  Min.   : 5.843   Min.   :0.7253   Min.   :24.44   Min.   :5.839             
##  1st Qu.: 6.838   1st Qu.:0.9777   1st Qu.:31.50   1st Qu.:6.260             
##  Median : 7.618   Median :1.1878   Median :34.65   Median :6.282             
##  Mean   : 7.741   Mean   :1.2090   Mean   :35.14   Mean   :6.310             
##  3rd Qu.: 8.384   3rd Qu.:1.3903   3rd Qu.:39.45   3rd Qu.:6.382             
##  Max.   :10.995   Max.   :1.8228   Max.   :56.06   Max.   :6.789             
##  NA's   :349      NA's   :239      NA's   :565     NA's   :657               
##  Tunisian.Dinar  U.A.E..Dirham   U.K..Pound.Sterling  U.S..Dollar
##  Min.   :1.342   Min.   :3.671   Min.   :1.213       Min.   :1   
##  1st Qu.:1.566   1st Qu.:3.672   1st Qu.:1.519       1st Qu.:1   
##  Median :1.723   Median :3.672   Median :1.599       Median :1   
##  Mean   :1.850   Mean   :3.672   Mean   :1.615       Mean   :1   
##  3rd Qu.:2.157   3rd Qu.:3.672   3rd Qu.:1.676       3rd Qu.:1   
##  Max.   :2.509   Max.   :3.675   Max.   :2.102       Max.   :1   
##  NA's   :4258    NA's   :71      NA's   :122
count(RATES)
##      n
## 1 5978
RATES <- RATES %>%
  drop_na()
count(RATES)
##     n
## 1 406

5.3 Ceny złota - GOLD

Pomiary cen złota były robione codziennie od 1968 roku do 2021 dla 3 walut w godzinach porannych i popołudniowych. Najmniejszą ilość danych pustych możemy zauważyć dla dolara mierzonego w godzinach porannych, dlatego do dalszej analizy użyjemy tej kolumny. Każda z tych walut odzwierciedla kurs złota. W ten sam sposób jedynie różnią się one kursem walutowym między sobą, dlatego wybranie jednej z nich będzie najlepsze. Dodatkowo w przypadku euro jest dużo danych pustych ze względu na to, że waluta ta powstała dopiero w 1999. Wartość pusta została uzupełniona na podstawie dnia poprzedniego lub jeśli on byłby pusty następnego.

summary(GOLD)
##      Date              USD..AM.          USD..PM.          GBP..AM.      
##  Length:13585       Min.   :  34.77   Min.   :  34.75   Min.   :  14.48  
##  Class :character   1st Qu.: 280.50   1st Qu.: 281.50   1st Qu.: 177.71  
##  Mode  :character   Median : 383.32   Median : 383.50   Median : 234.51  
##                     Mean   : 575.20   Mean   : 576.62   Mean   : 370.84  
##                     3rd Qu.: 841.94   3rd Qu.: 851.50   3rd Qu.: 454.32  
##                     Max.   :2061.50   Max.   :2067.15   Max.   :1574.37  
##                     NA's   :1         NA's   :143       NA's   :11       
##     GBP..PM.         EURO..AM.        EURO..PM.     
##  Min.   :  14.48   Min.   : 237.3   Min.   : 236.7  
##  1st Qu.: 178.23   1st Qu.: 335.3   1st Qu.: 335.2  
##  Median : 234.96   Median : 892.6   Median : 896.1  
##  Mean   : 371.81   Mean   : 797.3   Mean   : 797.2  
##  3rd Qu.: 456.43   3rd Qu.:1114.1   3rd Qu.:1114.9  
##  Max.   :1569.59   Max.   :1743.8   Max.   :1743.4  
##  NA's   :154       NA's   :7837     NA's   :7880
GOLD$Date <- as.Date(GOLD$Date,format="%Y-%m-%d")
GOLD <- select(GOLD, c('Date', 'USD..AM.'))
names(GOLD)[2] <- 'USD'
GOLD <- GOLD %>% fill(names(.),.direction="downup")
summary(GOLD)
##       Date                 USD         
##  Min.   :1968-01-02   Min.   :  34.77  
##  1st Qu.:1981-06-10   1st Qu.: 280.50  
##  Median :1994-11-14   Median : 383.30  
##  Mean   :1994-11-16   Mean   : 575.17  
##  3rd Qu.:2008-04-23   3rd Qu.: 841.75  
##  Max.   :2021-09-29   Max.   :2061.50
gg <- ggplot(data=GOLD, aes(x=Date,y=USD)) + geom_line() 

ggplotly(gg)

5.4 Indeks giełdowy S&P - COMP

W przypadku S&P Composite można zauważyć, że wartości nie było wiele i zostały one uzupełnione na podstawie poprzedniego miesiąca lub jeśli on byłby pusty to następnego. Pomiary były robione raz w miesiącu od 1871 roku z częstotliwością co miesiąc. Do późniejszej analizy zostały wybrane pomiary pochodzące od 1998 roku w górę, gdyż od tego roku pomiary zbierane były dla wartości złota.

summary(COMP)
##      Year           S.P.Composite         Dividend          Earnings       
##  Length:1810        Min.   :   2.730   Min.   : 0.1800   Min.   :  0.1600  
##  Class :character   1st Qu.:   7.902   1st Qu.: 0.4202   1st Qu.:  0.5608  
##  Mode  :character   Median :  17.370   Median : 0.8717   Median :  1.4625  
##                     Mean   : 327.968   Mean   : 6.7321   Mean   : 15.3714  
##                     3rd Qu.: 164.400   3rd Qu.: 7.0525   3rd Qu.: 14.7258  
##                     Max.   :4493.280   Max.   :59.6800   Max.   :158.7400  
##                                        NA's   :4         NA's   :4         
##       CPI         Long.Interest.Rate   Real.Price     Real.Dividend   
##  Min.   :  6.28   Min.   : 0.620     Min.   :  73.9   Min.   : 5.445  
##  1st Qu.: 10.20   1st Qu.: 3.171     1st Qu.: 186.6   1st Qu.: 9.417  
##  Median : 20.35   Median : 3.815     Median : 283.3   Median :14.411  
##  Mean   : 62.39   Mean   : 4.504     Mean   : 622.0   Mean   :17.498  
##  3rd Qu.:102.28   3rd Qu.: 5.139     3rd Qu.: 707.0   3rd Qu.:22.301  
##  Max.   :273.98   Max.   :15.320     Max.   :4477.2   Max.   :63.511  
##                                                       NA's   :4       
##  Real.Earnings     Cyclically.Adjusted.PE.Ratio
##  Min.   :  4.576   Min.   : 4.784              
##  1st Qu.: 14.063   1st Qu.:11.898              
##  Median : 23.524   Median :16.381              
##  Mean   : 34.907   Mean   :17.215              
##  3rd Qu.: 43.768   3rd Qu.:20.913              
##  Max.   :159.504   Max.   :44.198              
##  NA's   :4         NA's   :120
COMP$Year <- as.Date(COMP$Year)
COMP <- COMP %>% filter(COMP$Year >=as.Date("1968-01-01")) %>% fill(names(.),.direction="downup")
summary(COMP)
##       Year            S.P.Composite        Dividend         Earnings     
##  Min.   :1968-01-31   Min.   :  67.07   Min.   : 2.930   Min.   :  5.13  
##  1st Qu.:1981-07-07   1st Qu.: 122.53   1st Qu.: 6.401   1st Qu.: 13.83  
##  Median :1994-12-15   Median : 469.27   Median :13.133   Median : 24.69  
##  Mean   :1994-12-15   Mean   : 888.30   Mean   :17.872   Mean   : 41.76  
##  3rd Qu.:2008-05-23   3rd Qu.:1318.06   3rd Qu.:24.003   3rd Qu.: 67.47  
##  Max.   :2021-10-31   Max.   :4493.28   Max.   :59.680   Max.   :158.74  
##       CPI         Long.Interest.Rate   Real.Price     Real.Dividend  
##  Min.   : 34.10   Min.   : 0.620     Min.   : 306.3   Min.   :18.02  
##  1st Qu.: 90.85   1st Qu.: 3.757     1st Qu.: 598.0   1st Qu.:20.36  
##  Median :149.70   Median : 6.110     Median : 872.2   Median :24.16  
##  Mean   :147.31   Mean   : 6.140     Mean   :1289.3   Mean   :28.62  
##  3rd Qu.:212.07   3rd Qu.: 7.893     3rd Qu.:1772.0   3rd Qu.:31.02  
##  Max.   :273.98   Max.   :15.320     Max.   :4477.2   Max.   :63.51  
##  Real.Earnings     Cyclically.Adjusted.PE.Ratio
##  Min.   :  8.805   Min.   : 6.639              
##  1st Qu.: 41.947   1st Qu.:13.920              
##  Median : 50.181   Median :20.499              
##  Mean   : 65.438   Mean   :20.775              
##  3rd Qu.: 89.861   3rd Qu.:26.386              
##  Max.   :159.504   Max.   :44.198
gg<- ggplot(data=COMP, aes(Year)) + 
  geom_line(aes(y = S.P.Composite, colour = "S.P.Composite")) + 
  geom_line(aes(y = Dividend, colour = "Dividend")) + 
  geom_line(aes(y = Earnings, colour = "Earnings")) +
  geom_line(aes(y = CPI, colour = "CPI")) +
  geom_line(aes(y = Long.Interest.Rate, colour = "Long.Interest.Rate")) +
  geom_line(aes(y = Real.Price, colour = "Real.Price")) +
  geom_line(aes(y = Real.Dividend, colour = "Real.Dividend")) +
  geom_line(aes(y = Real.Earnings, colour = "Real.Earnings")) +
  geom_line(aes(y = Cyclically.Adjusted.PE.Ratio, colour = "Cyclically.Adjusted.PE.Ratio")) 

ggplotly(gg)

5.5 Ceny bitcoina - BITCOIN

Dane zawierające cenę bitcoina były zbierane od 2009 roku do 2021 z częstotliwością 1 dnia. Można zauważyć, że do dnia 2010-08-15 wartość bitcoina według wczytanych danych była równa 0. Podejrzewam, że jest to przybliżenie jego wartości wynikające z niskiej ceny w tamtym okresie lub brakiem jego mierzalnej wartości. W maju 2010 roku pewien programista zakupił 2 pizze warte około 30 dolarów za 10 000 bitcoinów, czyli bitcoin przed tamtym okresem przyjmował wartości poniżej 0,003$ za 1 bitcoina. Było to też pierwsze wykorzystanie bitcoina w celach konsumpcyjnych. Dodatkowo bitcoin został wprowadzony na giełdę w lutym 2010 roku i początkowo giełdy te nie zdobyły popularności, co także mogło mieć wpływ na te wartości.

summary(MKPRU)
##      Date               Value        
##  Length:4661        Min.   :    0.0  
##  Class :character   1st Qu.:    7.2  
##  Mode  :character   Median :  431.9  
##                     Mean   : 5141.2  
##                     3rd Qu.: 6499.1  
##                     Max.   :63554.4
MKPRU$Date <- as.Date(MKPRU$Date,format="%Y-%m-%d")
gg <- ggplot(data=MKPRU, aes(x=Date,y=Value)) + geom_line() 

ggplotly(gg)

6 Korelacja między zmiennymi

6.1 Cena złota a index giełdowy S&P

GOLDSP <- GOLD %>% mutate(Month = format(Date, format="%Y-%m"))
COMPSP <- COMP %>% mutate(Month = format(Year, format="%Y-%m"))
GOLDSP <- COMPSP %>% full_join(GOLDSP, by = "Month")
COR_GOLDSP <- GOLDSP %>% select(-c("Year", "Date", "Month")) %>% cor(use="pairwise.complete.obs")
corrplot(COR_GOLDSP, order = 'alphabet', number.cex=0.67, tl.cex = 0.67, addCoef.col = 'black', col = colorRampPalette(c('#E5D10A',"white","#BDE50A"))(200))

\52 z zbadanych atrybutów na 90 (bez wliczania korelacji między tymi samymi atrybutami) posiada korelacje powyżej 0.8 z czego 21 atrybutów powyżej 0.9. Zbiór atrybutów jest mocno skorelowany. W przypadku korelacji atrybutów z ceną złota można zauważyć, że najwiekszą korelacją cechują się atrybuty:
0.88 - Divident
0,86 - Earnings
0.83 - CPI
0.83 - Real.Divident

6.2 Cena złota a światowy wskaźnik rozwoju

GOLDINDI <- GOLD%>%
  mutate(Year = format(Date, "%Y")) %>%
  group_by(Year) %>%
  summarise(avgGOLD= mean(USD)) %>%
  transform(Year = as.numeric(Year))

INGOLD <- INDI %>% select(c("Series Name","Year","Value")) %>% mutate(Year = format(Year, format="%Y")) %>%
  transform(Year = as.numeric(Year))


INGOLD <- INGOLD %>% inner_join(GOLDINDI,by="Year")
INGOLD <- INGOLD %>% select(-c("Year"))


COR_BITCOMP <- INGOLD %>% group_by(INGOLD$Series.Name) %>% 
  summarise(cor = cor(Value, avgGOLD))
COR_BITCOMP_minus <- COR_BITCOMP %>% filter(COR_BITCOMP$cor < -0.9)
COR_BITCOMP_plus <- COR_BITCOMP %>% filter(COR_BITCOMP$cor > 0.9)

Część światowych wskaźników rozwoju w mocnym stopniu korelują z cenami złota (korelacja powyżej 0.90 lub korelacja poniżej -0.90). Dla korelacji dodatniej jest 19 takich wskaźników a dla ujemnej 11.

datatable(COR_BITCOMP_minus)
datatable(COR_BITCOMP_plus)

6.3 Cena złota a cena bitcoina

Współczynnik korelacji ceny złota od ceny bitcoina dla całego zbioru wyniósł 0.4981413 dlatego pomiędzy tymi dwiema zmiennymi możemy mówić o korelacji przeciętnej bądź średniej.

GOLDBIT <- merge(x = GOLD, y = MKPRU, by = "Date", all = TRUE)
GOLDBIT <- GOLDBIT %>%
  drop_na()
GOLDBIT$USD <- as.numeric(GOLDBIT$USD)
GOLDBIT$Value <- as.numeric(GOLDBIT$Value)
M <- cor(GOLDBIT$USD, GOLDBIT$Value, method=c("pearson", "kendall", "spearman"))
M
## [1] 0.4981413

Na wykresie można zauważyć, że dynamika wzrostu ceny od roku 2017 jest dużo wyższa dla bitcoina niż złota. Cena złota w latach 2009-2021 była dużo stabilniejsza niż cena bitcoina, który cechował się dużą zmiennością, stąd też wynika średnia korelacja tych atrybutów.

ggplot(data=GOLDBIT, aes(Date)) + 
  geom_line(aes(y = USD, colour = "Cena złota")) + 
  geom_line(aes(y = Value, colour = "Cena bitcoina")) +
  transition_reveal(Date)+
  scale_colour_manual(values = c("blue", "red")) +
  theme(legend.position = c(0.8, 0.9)) + 
  ggtitle("Bitcoin i złoto") 

6.4 Cena bitcoina a index giełdowy S&P

BITSP <- MKPRU %>% mutate(Month = format(Date, format="%Y-%m"))
BITCOMP <- COMP %>% mutate(Month = format(Year, format="%Y-%m"))
BITSP <- BITSP %>% full_join(BITCOMP, by = "Month")
COR_BITSP <- BITSP %>% select(-c("Year", "Date", "Month")) %>% cor(use="pairwise.complete.obs")
corrplot(COR_BITSP, order = 'alphabet', number.cex=0.67, tl.cex = 0.67, addCoef.col = 'black', col = colorRampPalette(c('#E5D10A',"white","#BDE50A"))(200))

przypadku korelacji atrybutów S&P między ceną bitcoina. Można zauważyć mniejszą korelacje niż pomiędzy złotem a atrybutami S&P. Najwiekszą korelacje pomiędzy Value Bitcoina a atrybutami S&P mamy dla atrybutów:
0.78 - S.P.Composite
0.76 - Real.Price
0.70 - Cyclically.Adjusted.PE.Ratio

6.5 Cena bitcoina a światowy wskaźnik rozwoju

BITINDI <- MKPRU%>%
  mutate(Year = format(Date, "%Y")) %>%
  group_by(Year) %>%
  summarise(avgBIT= mean(Value)) %>%
  transform(Year = as.numeric(Year))
summary(BITINDI)
##       Year          avgBIT        
##  Min.   :2009   Min.   :    0.00  
##  1st Qu.:2012   1st Qu.:    8.47  
##  Median :2015   Median :  525.60  
##  Mean   :2015   Mean   : 5855.95  
##  3rd Qu.:2018   3rd Qu.: 7362.71  
##  Max.   :2021   Max.   :44591.33
BITCOMP <- INDI %>% select(c("Series Name","Year","Value")) %>% mutate(Year = format(Year, format="%Y")) %>%
  transform(Year = as.numeric(Year))


BITCOMP <- BITCOMP %>% inner_join(BITINDI,by="Year")
BITCOMP <- BITCOMP %>% select(-c("Year"))


COR_BITCOMP <- BITCOMP %>% group_by(BITCOMP$Series.Name) %>% 
  summarise(cor = cor(Value, avgBIT))
COR_BITCOMP_minus <- COR_BITCOMP %>% filter(COR_BITCOMP$cor < -0.9)
COR_BITCOMP_plus <- COR_BITCOMP %>% filter(COR_BITCOMP$cor > 0.9)

Można zauważyć, że światowych wskaźników rozwoju w mocnym stopniu skorelowanych z cenami bitcoina jest znacząco mniej (korelacja powyżej 0.90 lub korelacja poniżej -0.90). Dla korelacji złota było ich 30 a dla bitcoina jest ich łącznie 17.

datatable(COR_BITCOMP_minus)
datatable(COR_BITCOMP_plus)

7 Regresor przewidujący ceny złota

Ceny złota były bardziej skorelowane z badanymi zbiorami danych oraz zbiór danych cen złota był dużo większy niż zbiór danych bitcoina który wartości niezerowe przyjmował dopiero od 2010. Dlatego regresor zostanie zbudowany do przewidywania cen złota. Ceny złota będą przewidywane na podstawie poniższych danych:
S&P:
- Divident
- Earnings
- CPI
- Real.Divident
Światowy wskaźnik rozwoju: -GDP (current US dollar) -Total greenhouse gas emissions (kt of CO2 equivalent)

Wskaźniki S&P zostały wybrane na podstawie poziomu korelacji, natomiast wskaźniki światowego rozwoju wytypowane zostały spośród 30 uzyskanych. Wskaźniki te są mocno związane z produkcją dóbr, powstawaniem miast na świecie i emisją gazów cieplarnianych związanych najczęściej z rozwojem przemysłu co może wpływać na prognozy cen złota. ## Wstępne przetworzenie danych

pre_COMP <- COMP %>% select("Year","Dividend","Earnings","CPI","Real.Dividend")
pre_COMP <- pre_COMP %>% mutate(Month = format(Year, format="%Y-%m"))
INDI_GDP <- INDI %>% filter(`Series Name` == "GDP (current US dollar)")
INDI_GDP <- rename(INDI_GDP, GDP=Value)
INDI_GDP <- INDI_GDP %>% select(c("Year", "GDP", )) %>%
  transform(Year = as.numeric(Year))
ggplot(INDI_GDP, aes(Year,GDP, group = 1)) +
  geom_line() +
  ggtitle("GPD")

INDI_Total <- INDI %>% filter(`Series Name` == "Total greenhouse gas emissions (kt of CO2 equivalent)")
INDI_Total <- rename(INDI_Total, GAS=Value)
INDI_Total <- INDI_Total %>% select(c("Year", "GAS")) %>%
  transform(Year = as.numeric(Year))
ggplot(INDI_Total, aes(Year,GAS, group = 1)) +
  geom_line() +
  ggtitle("GAS")

pre_GOLD <- GOLD %>% mutate(Month = format(Date, format="%Y-%m")) %>% group_by(Month) %>% summarise(avgGOLD= mean(USD))
pre_COMP <- pre_COMP %>% mutate(Month = format(Year, format="%Y-%m")) 

GOLD_COMB <- pre_GOLD %>% full_join(pre_COMP, by = "Month")
GOLD_COMB <- rename(GOLD_COMB, Date=Year)
GOLD_COMB <- GOLD_COMB %>% mutate(Year = format(Date, format="%Y")) %>% transform(Year = as.numeric(Year))
ALL_COMB <- GOLD_COMB %>% inner_join(INDI_Total, by = "Year")
ALL_COMB <- GOLD_COMB %>% inner_join(INDI_GDP, by = "Year")
summary(ALL_COMB)
##     Month              avgGOLD             Date               Dividend     
##  Length:612         Min.   :  34.95   Min.   :1970-01-31   Min.   : 3.070  
##  Class :character   1st Qu.: 292.01   1st Qu.:1982-10-23   1st Qu.: 6.855  
##  Mode  :character   Median : 384.96   Median :1995-07-15   Median :13.400  
##                     Mean   : 578.14   Mean   :1995-07-16   Mean   :17.799  
##                     3rd Qu.: 821.19   3rd Qu.:2008-04-07   3rd Qu.:23.885  
##                     Max.   :1971.17   Max.   :2020-12-31   Max.   :59.680  
##     Earnings           CPI         Real.Dividend        Year     
##  Min.   :  5.13   Min.   : 37.80   Min.   :18.02   Min.   :1970  
##  1st Qu.: 14.59   1st Qu.: 97.78   1st Qu.:20.24   1st Qu.:1982  
##  Median : 25.17   Median :152.50   Median :24.20   Median :1995  
##  Mean   : 41.52   Mean   :149.72   Mean   :28.33   Mean   :1995  
##  3rd Qu.: 66.63   3rd Qu.:211.28   3rd Qu.:30.88   3rd Qu.:2008  
##  Max.   :139.47   Max.   :260.47   Max.   :63.51   Max.   :2020  
##       GDP           
##  Min.   :2.987e+12  
##  1st Qu.:1.170e+13  
##  Median :3.088e+13  
##  Mean   :3.559e+13  
##  3rd Qu.:6.044e+13  
##  Max.   :8.761e+13

Po przetworzeniu i połączeniu wszystkich atrybutów powstał zbiór zawierający 612 rekordów i nie posiadający żadnych wartości pustych.

ALL_COMB <- ALL_COMB %>% select(-c("Month","Date","Year"))

7.1 Tworzenie modelu

Zbiór trenujący i testowy podzielono w proporcjach 75:25. A następnie wytrenowano model regresyjny randomForest.

smp_size <- floor(0.75 * nrow(ALL_COMB))
train_ind <- sample(seq_len(nrow(ALL_COMB)), size = smp_size)
trainset <- ALL_COMB[ train_ind,]
testset  <- ALL_COMB
predictors <- trainset %>% select(-avgGOLD) %>% as.matrix()
output <- trainset$avgGOLD
model <- randomForest(x = predictors, y = output,
                      ntree = 50) # number of trees


model
## 
## Call:
##  randomForest(x = predictors, y = output, ntree = 50) 
##                Type of random forest: regression
##                      Number of trees: 50
## No. of variables tried at each split: 1
## 
##           Mean of squared residuals: 2049.054
##                     % Var explained: 99.09
rmse(predict(model, testset), testset$avgGOLD)
## [1] 27.65493

7.2 Dostosowywanie modelu z wykorzystaniem careta

model_tuned <- train(avgGOLD ~ .,
             method = "rf",
             data = trainset,
             ntree = 5)
model_tuned
## Random Forest 
## 
## 459 samples
##   5 predictor
## 
## No pre-processing
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 459, 459, 459, 459, 459, 459, ... 
## Resampling results across tuning parameters:
## 
##   mtry  RMSE      Rsquared   MAE     
##   2     47.56395  0.9895347  26.55323
##   3     46.46304  0.9900294  25.97942
##   5     46.51963  0.9902986  26.39653
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 3.
ggplot(model_tuned)

W przypadku tuned_model wyniki są minimalnie lepsze od zwykłego modelu.

rmse(predict(model, testset), testset$avgGOLD)
## [1] 27.65493
mae(predict(model, testset), testset$avgGOLD)
## [1] 15.18075
rmse(predict(model_tuned$finalModel, testset), testset$avgGOLD)
## [1] 26.35187
mae(predict(model_tuned$finalModel, testset), testset$avgGOLD)
## [1] 13.19214

7.3 Analiza miary oceny

Do oceny przedstawionego modelu regresji zostały użyte 2 miary oceny:
- RSME - pierwiastek błędu średniokwadratowego. Przedstawia on różnicę między estymatorem a warością estymowaną. W przypadku lepszego modelu przyjął on wartość 26.35187. Jest to dobry wynik gdyż ceny złota przyjmowały wartości od 34.95 aż do 1971.17.
- MAE - jest to średni błąd bezwzględny wyniósł on 13.19214.

7.4 Analiza ważności atrybutów

Można zauważyć, że dla zwykłego modelu najważniejszym atrybutem było CPI z zbioru danych S&P natomiast dla modelu_tuned GPD z zbioru danych dotyczących światowych wskaźników rozwoju. Najmniejszy wpływ na uczenie modelu zwyłego miał Dividend, a dla tuned_model Earnings. Były to 2 atrybuty mocno skorelowane ze sobą.

par(mfrow = c(1,2))

varImpPlot(model, n.var = 5)
varImpPlot(model_tuned$finalModel, n.var = 5)